A projekthez a kaggle.com oldalon található, ‘The Movies Dataset’ nevű adathalmazt használtam fel, ami kb. 45 000, 2017. július előtt megjelent film metaadatait tartalmazza, kb. 270 000 felhasználói értékeléssel együtt.

Főbb adatpontok: megjelenési idő, nyelv, büdzsé, bevétel, értékelések, hossz, kulcsszavak a cselekményhez

Forrás: https://www.kaggle.com/rounakbanik/the-movies-dataset

A projektben felhasznált könyvtárak: ‘tidyverse’ szupercsomag, ‘jsonlite’, lubridate, wordcloud, reshape2, ggrepel, scales

library(tidyverse)
library(jsonlite)
library(lubridate)
library(wordcloud)
library(reshape2)
library(ggrepel)
library(scales)

Adatok beolvasása és rendezése

Az egyszerű ‘read.csv’ függvénnyel történik a beolvasás, mert a használt adatok a klasszikus angolszász módon (oszlopok vesszővel elválasztva, tizedesvesszők ponttal jelölve) vannak formázva. Először beállítjuk a munkamappát (ez R Notebook futtatásakor egyébként alapértelmezetten a fájt tartalmazó könyvtár), majd innen importáljuk az adatokat, kettő különböző fájlból.

setwd("C://Users/balin/Dropbox/Docs/University material/BMT TTK CogSci 2017-2018 II/R/notebook")
movies_metadata <- read.csv("movies_metadata.csv")
keywords <- read.csv("keywords.csv")

Mivel kettő különböző táblába tároltuk el a két fájl tartalmát, szükség lesz egy key-re, amivel azonosíthatjuk egymással az egyes megfigyeléseket. Az “id” nevű változó fogja betölteni ezt a szerepet. Amikor először leelenőrizzük, hogy több megfigyeléshez is tartozik-e egy kulcs, fény derül arra is, hogy miért van eltérő számú megfigyelés a fájlokban: néhány megfigyelés duplikált.

movies_metadata %>% 
  count(id) %>% 
  filter(n > 1)
keywords %>% 
  count(id) %>% 
  filter(n > 1)

Belenézve az adatokba kiderül, hogy ezek egyszerű duplikációk, így elég, ha egyet megtartunk belőlük a ‘distinct’ dplyr függvénnyel.

movies_metadata <- distinct(movies_metadata)
keywords <- distinct(keywords)

Kapcsoljuk hozzá a fő movies_metadata adattáblához a másik táblát is egy új, movies táblában. Az ‘inner_join’ függvényt használjuk, hogy csak azok az esetek kerüljenek be a végleges adathalmazba, amiről mindkét táblában volt adat.

movies <- inner_join(movies_metadata, keywords, by="id")

Hibaüzenetet kapunk. Próbáljuk meg integer típusra konvertálni az “id” változót mindkét táblában, majd próbáljuk újra a kapcsolást (és dobjuk is a többé nem használt táblákat).

movies_metadata$id <- as.integer(as.character(movies_metadata$id))
keywords$id <- as.integer(as.character(keywords$id))

movies <- inner_join(movies_metadata, keywords, by="id")

rm(movies_metadata, keywords)

Ezúttal sikerült. Kettő, a későbbi elemzés szempontjából fontos változó (genre, keywords) értéke nem egyértelmű formátumban van megadva. Az adatok dokumentációjában olvasható, hogy ezek JSON objektumok (pontosabban ezek vektorai). Egy példa:

movies$genres[1]
## [1] [{'id': 16, 'name': 'Animation'}, {'id': 35, 'name': 'Comedy'}, {'id': 10751, 'name': 'Family'}]
## 4066 Levels: [] ...

Ezeket szeretnék egyszerűbb listává alakítani, csak a műfajok nevével. Létezik egy olyan R-csomag, ami képes a JSON és az R adattípusok között konvertálni, ez a jsonlite. Sajnos, ha megpróbáljuk a csomag ‘fromJSON’ függvényével első nekifutásra átkonvertálni ezeket az értékeket, hibaüzenetet kapunk arról, hogy nem ismeri fel az argumentumot mint JSON objektumot.

Némi utánajárás után kiderül, hogy a probléma ott van, hogy JSON-ban dupla idézőjelet használnak, nem szimplát. Cseréljük ki ezeket a karaktereket az említett változóknál a ‘gsub’ függvénnyel, de úgy, hogy a szövegben mint stringben előforduló aposztrofok ne sérüljenek. Ezt RegEx-el oldjuk meg. Kivesszük továbbá a később amúgy sem használt backslasheket a keywords változó értékeiből, mert azok is zavarják a JSON parsert.

movies$genres <- gsub("'(?=\\:|\\,|\\})|(?<=\\{|\\:\\s|\\,\\s)'", "\"", movies$genres, perl = TRUE)
movies$keywords <- gsub("'(?=\\:|\\,|\\})|(?<=\\{|\\:\\s|\\,\\s)'", "\"", movies$keywords, perl = TRUE)
movies$keywords <- gsub("([\\])","", movies$keywords)

Így már használható a ‘fromJSON’ függvény, amivel már át tudunk menni az egyes változókon, hogy R-kompatibilis listát készítsünk. Csak a name vektorokat tartjuk meg a listákból, az id-ra nem lesz szükség. Végül egyszerűsítsük a listákat homogénebb karaktervektorokká az ‘unlist’ függvénnyel.

movies$genres <- lapply(movies$genres, fromJSON)
movies$genres <- lapply(movies$genres, "[", c("name"))
movies$genres <- lapply(movies$genres, unlist)

movies$keywords <- lapply(movies$keywords, fromJSON)
movies$keywords <- lapply(movies$keywords, "[", c("name"))
movies$keywords <- lapply(movies$keywords, unlist)

Az áttekinthetőség érdekében eltávolítunk néhány oszlopot, amiket biztosan nem tervezünk felhasználni az elemzés során.

movies$belongs_to_collection <- NULL
movies$homepage <- NULL
movies$poster_path <- NULL
movies$production_companies <- NULL
movies$production_countries <- NULL
movies$spoken_languages <- NULL
movies$tagline <- NULL
movies$original_title <- NULL
movies$video <- NULL

Beállítjuk a release_date változó típusát dátumra, mert faktorként volt eddig beolvasva. A lubridate csomag ‘year’ függvényével tudjuk majd ezekből az értékekből kinyerni külön az évet, nézzük erre is egy példát.

movies$release_date <- as.Date(movies$release_date)
year(movies$release_date[1])
## [1] 1995

Megfigyelhető, hogy ebben az adattáblában a budget, revenue és runtime változók hiányzó értékeit 0-val jelölték, ami később torzíthatja az elemzéseinket. Állítsuk át őket a hiányzó értéket jelző értékre.

movies$budget[movies$budget == 0] <- NA
movies$revenue[movies$revenue == 0] <- NA
movies$runtime[movies$runtime == 0] <- NA

A még ki nem adott és a felnőtt filmekre nem leszünk kíváncsiak. Mielőtt azonban ezeket is kiszednénk az adattáblánkból, nézzük meg, hogy hány ilyen film van.

count(movies, adult == "False", status == "Released")

Relative nem sok, szűrjük is ki ezeket.

movies <- filter(movies, adult == "False", status == "Released")
movies$adult <- NULL
movies$status <- NULL

Nagyjából készen vagyunk az adatok előkészítésével. Nézzünk most rájuk tibble formátumban.

as.tibble(movies)

Adatok elemzése és ábrázolása

Először nézzük meg, immár a ggplot csomag segítségével, hogy a filmek hogyan oszlanak el időben (év szerint).

ggplot(data = movies) +
     geom_bar(mapping = aes(year(release_date)), width = 1) +
     labs( x = "Kiadás éve", y = "Filmek száma")

Úgy tűnik, egy fokozatos növekedést követően az ezredforduló környékén kezd el hirtelen megszaporodni a filmek száma – legalábbis az adathalmazban mindenképpen. Hogy ez mennyire reprezentálja a filmmegjelenések valós arányát, az kérdéses.

Nézzük meg ugyanezt, de most külön az angol és nem angol nyelvű filmekre szűrve, és csak a ’60-as évektől felfelé.

movies %>% 
     filter(original_language == "en", year(release_date) >= 1960) %>% 
     ggplot(mapping = aes(year(release_date))) +
     geom_bar(width = 1) +
     labs( x = "Kiadás éve", y = "Filmek száma", title ="Angol nyelvű filmek")

movies %>% 
     filter(original_language != "en", year(release_date) >= 1960) %>% 
     ggplot(mapping = aes(year(release_date))) +
     geom_bar(width = 1) +
     labs( x = "Kiadás éve", y = "Filmek száma", title ="Nem angol nyelvű filmek")

Hasonló mintázatokat látunk (persze eltérő nagyságrendekben), talán annyi különbséggel, hogy a ’70-as és ’90-es évek között mintha átmenetileg csökkent és stagnált volna a nem angol nyelvű filmkiadás. Persze ennek hátterében újfent lehet mintavételi torzítás is.

Nézzük meg a filmek értékelésének és hosszának eloszlását. Mivel egyébként első ránézésre furcsa szélsőértékeket is felvesz a runtime változó (az 1200 perc hosszú film elég extrémnek tűnik, feltehetőleg egy sorozatról van itt szó), szűrjük az eseteinket a max. 450 perces filmekre, ez a “Sátántangó” című Tarr Béla-film hossza, amit már komoly kihívás egyben végignézni.

movies %>% 
     filter(vote_count >= 100) %>% 
     ggplot(mapping = aes(vote_average)) +
     geom_density(kernel="gaussian") +
     labs( x = "Értékelés", y = "Sűrűség")

movies %>% 
     filter(runtime <= 450) %>% 
     ggplot(mapping = aes(runtime)) +
     geom_density(kernel="gaussian") +
     labs( x = "Hossz", y = "Sűrűség")

A filmek értékelésénél szűrtünk a legalább 100 értékelést kapott filmekre enyhén ferde, de normálnak mondható előszlást kaptunk (egy 6-7 közötti módusszal), míg a hossznál egy meglehetősen csúcsosat (90 körüli módusszal).

Most nézzük meg, hogyan viszonyul egymáshoz a filmek kedveltsége és hossza. Ehhez vegyük csak azokat a filmeket, amikre legalább 100 értékelés érkezett, maximum 250 percesek, és 1960 után jelentek meg.

movies %>% 
     filter(
       runtime <= 250,
       vote_count >= 100,
       year(release_date) >= 1960
       ) %>% 
     ggplot(mapping = aes(runtime, vote_average)) +
     geom_point(position="jitter", size = 1, alpha = 2/10) +
     labs( x = "Hossz", y = "Kedveltség")

Úgy tűnik, minél kedveltebb egy film, annál valószínőbb, hogy deviál az átlagos 90-100 perc körüli hossztól valamely irányban. Nézzük meg csak a 90 és 250 perc közötti filmekre ugyanezt, és színezzük a pontokat a megjelenés éve szerint.

movies %>% 
     filter(
       between(runtime, 90, 250),
       vote_count >= 100,
       year(release_date) >= 1960
       ) %>% 
     ggplot(mapping = aes(runtime, vote_average, colour = year(release_date))) +
     geom_point(position="jitter",  size = 0.6) +
     geom_smooth(method = "gam") +
     labs( x = "Hossz", y = "Kedveltség", colour ="Megjelenés éve")

A mintázat azt sejteti, mintha 90 perc felett lenne egy enyhe korreláció a hossz és a kedveltség között.

Tárjuk fel egy kicsit szemléletesebben ezt a mintázatot: hozzunk létre övezeteket az évszámokból, és fazettázzuk a pontfelhőt ezek szerint. Így ráláthatunk, hogyan járulnak hozzá az egyes időszakokban megjelent filmek a fenti mintázathoz.

movies <- movies %>%
   mutate(decade = case_when(
      (year(release_date) >= 1910 & year(release_date) < 1920) ~ "1910s",
      (year(release_date) >= 1920 & year(release_date) < 1930) ~ "1920s",
      (year(release_date) >= 1930 & year(release_date) < 1940) ~ "1930s",
      (year(release_date) >= 1940 & year(release_date) < 1950) ~ "1940s",
      (year(release_date) >= 1950 & year(release_date) < 1960) ~ "1950s",
      (year(release_date) >= 1960 & year(release_date) < 1970) ~ "1960s",
      (year(release_date) >= 1970 & year(release_date) < 1980) ~ "1970s",
      (year(release_date) >= 1980 & year(release_date) < 1990) ~ "1980s",
      (year(release_date) >= 1990 & year(release_date) < 2000) ~ "1990s",
      (year(release_date) >= 2000 & year(release_date) < 2010) ~ "2000s",
      (year(release_date) >= 2010 & year(release_date) < 2020) ~ "2010s")
   )

movies$decade <- as.factor(movies$decade)
movies %>% 
     filter(
       between(runtime, 90, 250),
       vote_count >= 100,
       year(release_date) >= 1960
       ) %>% 
     ggplot(mapping = aes(runtime, vote_average)) +
     geom_point(position="jitter",  size = 1, alpha = 2/10) +
     facet_grid(. ~ decade) +
     labs( x = "Hossz", y = "Kedveltség")

Nézzük meg azt is, hogy alakul az egyes évtizedekben megjelent filmek átlagos kedveltsége.

movies %>% 
     filter(
       vote_count >= 200,
       year(release_date) >= 1960
       ) %>% 
     ggplot(mapping = aes(decade, vote_average)) +
     geom_boxplot(alpha = 3/10) +
     labs( x = "Évtized", y = "Átlagos kedveltség") +
     theme_light() +
     theme(panel.grid.major.x = element_blank(),  panel.grid.minor.x = element_blank())

Talán informatívabb, ha nem magukat az átlagokat, hanem az évtizedekhez tartozó eloszlásokat jelenítjük meg egy-egy ábrán.

movies %>% 
     filter(runtime <= 250, year(release_date) >= 1960) %>% 
     ggplot(mapping = aes(runtime, colour = decade)) +
     geom_density(kernel="gaussian") +
     labs( x = "Hossz", y = "Sűrűség", colour ="Évtized", 
           title="Az egyes évtizedekben megjelent filmek hosszának eloszlása")

movies %>% 
     filter(vote_count >= 100, year(release_date) >= 1960) %>% 
     ggplot(mapping = aes(vote_average, colour = decade)) +
     geom_density(kernel="gaussian") +
     labs( x = "Értékelés", y = "Sűrűség", colour ="Évtized",
           title="Az egyes évtizedekben megjelent filmek kedveltségének eloszlása")

Ezeken az ábrákon az látszik, hogy a filmek hossza az időben előre haladva hasonlóan unimodális, de egyre csúcsosabb eloszlást követ. Az egyes évtizedekben megjelent filmek kedveltségének eloszlása pedig az időben előre haladva egyre laposabb, egyre alacsonyabb módusszal.

Térjünk rá a műfajokra. Először nézzük meg, hogy hány egyedi műfaj-címke van egyáltalán a táblában, és mik ezek.

genres_names <- unique(unlist(movies$genres))
genres_names
##  [1] "Animation"       "Comedy"          "Family"         
##  [4] "Adventure"       "Fantasy"         "Romance"        
##  [7] "Drama"           "Action"          "Crime"          
## [10] "Thriller"        "Horror"          "History"        
## [13] "Science Fiction" "Mystery"         "War"            
## [16] "Foreign"         "Music"           "Documentary"    
## [19] "Western"         "TV Movie"

A 20 címke alapján hozzunk létre változókat, melyek logikai vektorok lesznek, az egyes filmekhez tartozó logikai értékkel.

for (i in genres_names) {
     movies[[i]] <- unlist(lapply(lapply(movies$genres, is.element, i), any))
}

Így már meg tudjuk nézni például a háborús filmek időbeli eloszlását. Ezúttal a témához illő sötét tónussal megjelenítve.

movies %>% 
     filter(War == "TRUE") %>% 
     ggplot(mapping = aes(year(release_date))) +
     geom_bar(colour = "black", width = 1) +
     labs( x = "Kiadás éve", y = "Filmek száma", title ="Háborús filmek száma") +
     theme_dark()

Egy érdekes, ciklikus mintázat látható. Ennél valamivel beszédesebb, ha a háborús filmek arányát ábrázolnánk az egyes időszakokban. Jól látszik, hogy az évezred első felében hangsúlyosabbak voltak ezek a filmek:

movies %>% filter(year(release_date) >= 1925) %>%
       ggplot(mapping = aes(year(release_date), fill = War)) +
       geom_bar(position ="fill", width = 1) +
       labs( x = "Kiadás éve", y = "Filmek száma", title ="Háborús filmek") +
       scale_fill_grey(start = 0.8, end = 0.1, na.value = "red", name = "", labels = c("Nem háborús", "Háborús")) +
       theme_minimal()

Azt is meg tudjuk nézni, melyik a legkedveltebb és legkevésbé kedvelt műfaj-kombináció (pl. azok között, amelyek minimum százszor fordultak elő a mintában és minimum 100 értékelést kaptak). Ehhez csoportosítsuk az adatainkat aszerint, hogy az egyes műfajoknál milyen logikai értéket vesznek fel, és nézzük meg az átlagos értékelést az egyes kombinációknál, majd ezt a listát rendezzük csökkenő sorrendbe. Ez kicsit trükkös, mert a group_by függvénynek csak úgy lehet vektorizáltan megadni az argumentumait, ha a vektort először átalakítjuk karaktervektorból szimbólumlistává. Eszerint az elemzés szerint önmagában a dráma a legkedveltebb, amit a szerelmi dráma kombináció követ, majd pedig a dráma-vígjáték:

genres_names_dots <- lapply(genres_names, as.symbol)

movies %>% 
   filter(vote_count >= 100) %>%
   group_by(.dots = genres_names_dots) %>%
   summarize(
     count = n(),
     avg_vote = mean(vote_average)
     ) %>% 
   filter(count >= 100) %>%
   arrange(desc(avg_vote))

Alapvető probléma, hogy egy filmhez több műfajkategória is tartozik, és ezek széles formában vannak az adattáblában reprezentálva, ami nehézzé teszi csak az egyes műfajok plottolását. Szerencsére a reshape2 csomag ‘melt’ függvényével átalakítható ez a reprezentáció hosszú formába. Így egy film több sorban is szerepelhet, attól függően, hány műfajhoz tartozik.

movies_long <- melt(movies,
                    id.vars = c("title", "id", "imdb_id", "release_date", "decade",  
                                "runtime", "budget", "revenue", "vote_average", 
                                "vote_count", "keywords"), 
                    measure.vars = genres_names, variable.name = "Genre") %>% 
                    filter(value == "TRUE")

movies_long$value <- NULL

Az új data.frame segítségével már tudjuk ábrázolni például az egyes műfajok átlagos kedveltségét és hosszát. Hasonlítsuk össze a nagyobb időtávban megjelent filmeket az 1960-as és a 2010-es évek megjelenéseinek plottolásán keresztül

movies_long %>% 
     filter(vote_count >= 10, 
            between(year(release_date), 2010, 2020)
            | between(year(release_date), 1960, 1969)) %>%
     ggplot(mapping = aes(Genre, vote_average)) +
     stat_summary(
         fun.ymin = min,
         fun.ymax = max,
         fun.y = mean
     ) +
     labs( x = "", y = "Kedveltség", 
           title = "A legalább 10 szavazatot kapott filmek átlagos kedveltsége műfajonként") +
     coord_flip() +
     facet_grid(. ~ decade)

movies_long %>% 
     filter(between(runtime, 60, 180), 
            between(year(release_date), 2010, 2020)
            | between(year(release_date), 1960, 1969)) %>%
     subset(!is.na(runtime)) %>%
     ggplot(mapping = aes(Genre, runtime)) +
     stat_summary(
         fun.ymin = min,
         fun.ymax = max,
         fun.y = mean
     ) +
     labs( x = "", y = "Hossz", 
           title = "60 - 180 perc közötti filmek átlagos hossza műfajonként") +
     coord_flip() +
     facet_grid(. ~ decade)

Nézzük meg, hogy az egyes évtizedek filmjei közül melyek a legnépszerűbbek és legkevésbé népszerűek egy-egy műfajban.

movies_long %>% 
   subset(!is.na(decade)) %>%
   filter(vote_count >= 100) %>%
   group_by(Genre, decade) %>%
   summarize(
     BestVote = max(vote_average), BestTitle = title[which.max(vote_average)],
     WorstVote = min(vote_average), WorstTitle = title[which.min(vote_average)])

A kulcsszavak esetén már sokkal több egyedi értékünk van. Nézzük meg az első 50 leggyakoribbat.

sort(table(unlist(movies$keywords)), decreasing=TRUE)[1:50]
## 
##       woman director     independent film               murder 
##                 3012                 1895                 1280 
##       based on novel              musical                  sex 
##                  817                  718                  676 
##             violence               nudity              revenge 
##                  645                  625                  616 
##            biography             suspense                 love 
##                  610                  575                  560 
##        female nudity                sport               police 
##                  554                  528                  450 
## duringcreditsstinger             teenager               sequel 
##                  440                  432                  429 
##           friendship         world war ii                 drug 
##                  406                  390                  357 
##      stand-up comedy               prison          high school 
##                  347                  346                  313 
##         martial arts              suicide                 rape 
##                  310                  306                  302 
##            film noir          silent film           kidnapping 
##                  301                  301                  299 
##               family        serial killer              monster 
##                  289                  288                  277 
##                alien             dystopia             new york 
##                  274                  268                  265 
##                paris                blood                  gay 
##                  265                  262                  258 
##                short             marriage            christmas 
##                  254                  253                  249 
##                 gore                death             gangster 
##                  242                  241                  241 
##           small town               zombie            detective 
##                  236                  235                  233 
##  aftercreditsstinger       london england 
##                  231                  231

Nézzük meg évtizedek szerinti bontásban az első 5 leggyakoribbat.

movies %>% 
   subset(!is.na(decade)) %>%
   group_by(decade) %>%
   summarize(
     Key1 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[1],
     Key2 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[2],
     Key3 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[3],
     Key4 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[4],
     Key5 = as.data.frame(sort(table(unlist(keywords)), decreasing=TRUE)[1:5])$Var1[5],)

Használjuk a wordcloud csomagot szófelhő készítésére az első 100 leggyakoribb kulcsszóból (mondjuk az 1960 és 1990 közötti filmeknél).

library(RColorBrewer)

keysfreq <- as.data.frame(
  sort(table(unlist(
    filter(movies, between(year(release_date), 1960, 1990))$keywords)),
    decreasing=TRUE)
  [1:100])

pal <- brewer.pal(8,"Dark2")
pal <- pal[-(1:2)]

wordcloud(words = keysfreq$Var1, freq = keysfreq$Freq,
          random.order=FALSE, scale=c(4,.5), rot.per=0, fixed.asp=FALSE, colors=pal)

A magyar nyelvű filmek kulcsszavai:

library(RColorBrewer)

keysfreq <- as.data.frame(
  sort(table(unlist(
    filter(movies, original_language == "hu")$keywords)),
    decreasing=TRUE)
  [1:100])

pal <- brewer.pal(9, "BuGn")
pal <- pal[-(1:2)]

wordcloud(words = keysfreq$Var1, freq = keysfreq$Freq,
          random.order=FALSE, scale=c(4,.5), rot.per=0, fixed.asp=FALSE, colors=pal)

Érdekesség, hogy ggplottal is lehet szófelhőt generálni. Ehhez még szükség lesz a ggrepel csomagra is. (http://mhairihmcneill.com/blog/2016/04/05/wordclouds-in-ggplot.html)

Nézzük meg ezzel a módszerrel, hogy mennyiben mások a kulcsszavak az 1920 és 1950 között megjelent filmeknél.

keysfreq <- as.data.frame(
  sort(table(unlist(
    filter(movies, between(year(release_date), 1920, 1950))$keywords)),
    decreasing=TRUE)
  [1:50])

keysfreq %>% 
ggplot +
  aes(x = 1, y = 1, size = Freq, colour = Freq, label = Var1) +
  geom_text_repel(segment.alpha = 0, force = 50) +
  scale_size(range = c(2, 10), guide = FALSE) +
  scale_y_continuous(breaks = NULL) +
  scale_x_continuous(breaks = NULL) +
  labs(x = '', y = '', colour = 'Gyakoriság', title ='Az 1920-1950-es korszak filmjeinek kulcsszavai') +
  scale_colour_gradient(low="blue", high="orange") +
  theme_classic()

A pénzügyekre is kíváncsiak vagyunk, bár azokról elég ritkák az adataink: jelen esetben első pillantásra felmerül a gyanú, hogy a budget és revenue változók értékei gyakran hiányoznak. Nézzük meg, hányszor van ilyen.

count(movies, is.na(budget), is.na(revenue))

Sajnos meglepően sokszor: mindössze 5377 olyan eset van, ahol az értékek nem hiányoznak.

Nézzük meg milyen kapcsolat van a filmek költségvetése / bevétele és kedveltsége között. (Mivel nincs sok adatpontunk ezen változók mentén, most ne bontsuk tovább őket évtized / műfaj / nyelv szerint.)

movies %>% 
    subset(!is.na(budget) & !is.na(vote_average)) %>% 
    filter(revenue > 0, vote_count >= 10) %>%  
    ggplot(mapping = aes(vote_average, budget)) +
    geom_smooth(size = 1, fullrange = FALSE, colour = "blue", se = FALSE) +
    labs( x = "Kedveltség", y = "Költségvetés (dollár)") +
    scale_y_continuous(labels = dollar) +
    theme_light()

movies %>% 
    subset(!is.na(revenue) & !is.na(vote_average)) %>%
    filter(revenue > 0, vote_count >= 10) %>%  
    ggplot(mapping = aes(vote_average, revenue)) +
    geom_smooth(size = 1, fullrange = FALSE, colour = "red", se = FALSE) +
    labs( x = "Kedveltség", y = "Bevétel (dollár)") +
    scale_y_continuous(labels = dollar) +
    theme_light()

A filmek kedveltsége és bevétele között láthatóan erős összefüggés van. A kedveltség és költségvetés között már egy érdekesebb, fordított U összefüggést látunk: a közepes, 5-6-os értékelésig ahogy nő a kiadás, úgy nő az értékelés, ezt követően azonban megfordul a viszony (érdemes persze megnézni a skálán ennek a nagyságrendjét)

Végül pedig nézzük meg az összefüggést a filmek költségvetése és bevétele között. Egy

movies %>% 
     subset(!is.na(budget) & !is.na(revenue)) %>%
     ggplot(mapping = aes(budget, revenue)) +
     geom_point(position="jitter",  size = 1, alpha = 10/10, colour = "yellow") +
     geom_smooth(size = 1, fullrange = FALSE, colour = "orange", se = FALSE) +
     labs( x = "Költségvetés (dollár)", y = "Bevétel (dollár)") +
     scale_y_continuous(labels = dollar) +
     scale_x_continuous(labels = dollar) +
     theme_light()